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مقدمة 

يموي ا اک aud дай. ДЬ at‏ العامة ыд‏ ار اا تقل الان 
مواضيع عديدة منها التعامل مع | لمجموعات والسجلات والملفات بنوعيها il‏ لنصية والثنائية » LS‏ تحوي 
مسائل في المؤشرات بشكل معمق ومكثف من خلال مسألتين كبيرتين تغطي أفكار هامة وعميقة في عالم 
المؤشرات. 

هذا الكتيب ليس موجه للأشخاص الذين يودون تعلم لغة البرمجة باسكال وحسبء وإنما لكل من يريد أن 
يستعرض الكتيب مسائل في أبحاث (вебе уламай!‏ والعمليات عليهاء التسجيلات (Records)‏ 
ЫШ алы;‏ هع „йй adi АЛЫ E а ах А бай etd]‏ 
уа ст es‏ ى ان ر 

الشيفرات البرمجية تم تجريبها وهي تعمل بشكل صحيح» كما أنها متوفرة للتحميل من خلال منصة 
-Source forge‏ 


سأكون مسروراً G=‏ بملاحظاتكم على هذا الكتيب» وأرجو ألا تبخلو بها. 
آمل من الله تعالى أن يكون هذا الكتيب مفيداً لكم وأن يقدم العون إلى كل من يريد أن يتعلم البرمجة عموماً ولغة 
الباسكال خصوصاًء وأرجو أن يكون عملي هذا في صحيفة أعمالي» والله من وراء القصد. 


دمشق في 2014-7-7 


محمد العليان 


المسألة 1 : 

سوف نتعامل في هذه المسألة مع مجموعات قواسم الأعداد الصحيحة الموجبة لتساعدنا على إيجاد العديد من 
العلاقات الكائنة eis‏ 

سنقصر الاهتمام في البداية على مجال الأعداد الموجبة من 1 إلى 255‹ إذ يمكن ألا يتمكن الكثير من 
المترجمات ОМАШ‏ مع مجموعات تتعدى هذا المجال» ولكن الحل سييقى Lite‏ 


بداية سيقوم البرنامج بإيجاد مجموعة القواسم الخاصة بكل من أعداد المجال المدروس وسنخزن لكل عدد 
مجموعة قواسمه ماعدا نفسه وفق البنية التالية: 
Const МахМ-255;‏ 
Type range= 1..maxN;‏ 


Type SetDivizer= set of range; 
Type TabSetDiv = array [range] of SetDivizer 


نعرّف )13 ha‏ جدول مجموعات أعداد صحيحة TabSetDiv‏ ونخزن في متحول من هذا АШ‏ 
مجموعات القواسم. فإذا كان لدينا المتحول VTabSet‏ من (TabSetDiv Jill‏ عندها تكون نتيجة الخزن 


VTabSet[1] =[1]; 
VTabSet[2] =[1]; 
VTabSet[3] =[1]; 
VTabSet[4] =[1,2]; 


VTabSet[255] =[1,3,5,15,17,51,85]; 


تطلس من Е о дарда ILE‏ 
جدول وفق البنية المبينة آنفاًء ونقوم على التوازي بوضع مجموع قواسم هذه الأعداد في جدول» كما يطلب 
كتابة برنامج جزئي Cd procedure‏ بإظهار محتوى مجموعة أعداد صحيحة. 


والآن يُطلب من البرنامج باستخدام المجموعات وجدول مجاميع القواسم» إيجاد مايلي: 
أ-إظهار مجموعة قواسم أي عدد ضمن مجال المسألة. 

ب-إظهار الأعداد الكاملة: (العدد الكامل يساوي مجموع قواسمه). 

ج-إظهار مجموعة القواسم المشتركة لعددين. 


د-إظهار مجموعة المضاعفات المشتركة لعددين والواقعة ضمن المجال. 


ه -إظهار مجموعة alae YI‏ الأولية. 
الأكواد البرمجية لجميع مسائل هذا الكتيب موجودة على الرابط التالي : 


http://sourceforge.net/projects/pascalgeneralproblem 


program set text; 
const maxnz255; 
type range =1..maxn; 
type setdivizere=set of range; 
type tabsetdiv=array [range]of setdivizere; 
type tabsum=array[range] of integer; 
var vts,dts :tabsetdiv; 
seet:setdivizere; 
sum:tabsum; 
num1,num2,i,j,n:integer; 
c:char; 
procedure creat setdivizere(var vst:tabsetdiv;var sum:tabsum); 
begin 
vst[1]:s[1] ; 
ѕит[1]:=1 ; 
for i:=2 to 255 do 
begin 
for j:-1 to i-1 do 
begin 
if (i mod j = 0) then 
begin 
vst[i]:=vst[i]+[j]; 
sum[i]:=sum[i]+j; 
end; 
end; 
end; 
end; 


procedure creat_double(var dst:tabsetdiv); 


begin 
for i:=1 to 255 do 
begin 
for j:=i to 255 do 
begin 
if (j mod i =0 )then 
dst[i]:=dst[i]+[j]; 
end; 
end; 
end; 


procedure menu(var c:char); 


begin 

repeat 
WRITELN(' THE MENU "ys 
writeln(' (S)ET DIVIZER V ys 


writeln(' (C)OMPLETED NUMBER у; 


writeln(' (D)IVIZER BETWEEN '); 
writeln(' (M)ULTIPLYING BETWEEN '); 
writeln(' (P)INARY "у; 
writeln(' (E)XIT و("‎ 


writeln('WRITE THE FIRST LETTER OF THE ORDER YOU WANT TO DO'); 
readln(c); 
until c an [^s ' ,"$' "et "C d', D','m', M', p a B. es Е: 
WRITELN; 
end; 


procedure read number(var n :integer); 
begin 
writeln('READ THE NUMBER YOU WANT '); 
readln(n); 
while (n«1)or (n>255) do 
begin 
writeln('YOUR NUMBER IS WRONG........... PLEASE ENTER IT AGAIN '); 
readin(n); 
WRITELN; 
end; 
end; 


procedure print set(s:setdivizere); 
begin 
writeln('THESE ARE THE ELEMENTS OF THE SET'); 
WRITELN; 
WRITELN; 
for i:-1 to 255 do 
begin 
if (i in s) then 
write(i,' - '); 
end; 
writeln; 
writeln; 
end; 


procedure divi(n:integer); 
begin 

print set(vts[n]); 
end; 


procedure complet(var s:setdivizere); 
begin 
for i:=2 to 255 do 
begin 
if (sum[i]zi) then {if the number = sum of(divition) sum[i]; procedure} 
$:=5+[1];{а4а i ; complet number to set ) (remember sum[i] type of setdiviser } 
end; 
end; 
if (sum[i]zi) then {if the number = sum of(divition) sum[i]; procedure} 
s:=st[i];fadd i ; complet number to set } (remember sum[i] type of setdiviser } 
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end; 
end; 


procedure divbetween(num1,num2:integer;var s:setdivizere); 
begin 

s:=vts[num1]*vts[num2]; 
end; 


procedure doublebetween(num1,num2:integer; var s:setdivizere) ; 
begin 

s:=dts[num2]*dts[num1]; 
end; 


procedure pinary(var s:setdivizere) ; 
var pin:boolean; 
begin 
s:-[2]; 
for i:=3 to 255 do 
begin 
pin:-true; 
ј:=2; 
while (pin)and(j<i) do 
begin 
if(i mod j =0)then 
pin:=false; 
j:=j+1; 
end; 
if(pin =true)then 
5:=5+[1]; 
епа; 
епа; 
///////////////////////////////////////////////////////////////// 
Begin { program Start ) 


seet:=[]; 

for i:=1 to n do 

begin 
vts[i]:-[]; 
ѕит[1]:=0; 
dts[i]:-[]; 

end; 


creat setdivizere(vts,sum); 
creat double(dts); 
menu(c); 
while (c«»'e')and(c«»'E')do 
begin 
ѕееї:=[]; 
case с of 
'S','S': begin 
read number(n); 
divi(n); 
end; 
'c','C':begin 
complet(seet); 


print set(seet); 
end; 


'd','D': begin 
read number(num1); 
read number(num2); 
divbetween(num1,num2, seet); 
print_set(seet) ; 
end; 
'M','M': begin 
read_number(num1) ; 
read_number(num2) ; 
doublebetween(num1,num2,seet) 5 
print_set(seet) ; 
end; 
p','P':begin 
pinary(seet); 
print set(seet); 


end; 
end; 
menu(c); 
end; 
print set(seet); 
end; 
'p','P':begin 
pinary(seet); 
print set(seet); 
end; 
end; 
menu(c); 
end; 


End.{End of the program } 


المطلوب في هذه المسألة التعامل مع الأعداد العقدية. إن بنية المعطيات المستخدمة لتمثيل عدد عقدي هي 
تسجيلة؛ لها حقلان: Jia‏ المركبة الحقيقية» وحقل المركبقى التخيلية للعدد العقدي. 


البرامج الجزئية التي تحقق العمليات العقدية» والمطلوب برمجتها هي: 
aas : Cadd‏ عددين عقديين. 

Csub‏ : طرح عددين عقديين. 

:Cmul‏ ضرب عددين عقديين. 

:Cdiv‏ قسمة عددين عقديين. 

:CReead‏ قراءة عددين عقديين. 

Write‏ كتابة عدد عقدي. 

:CSet‏ إسناد Аай‏ لعدد عقدي. 

و تابع يحسب طويلة العدد العقدي. 


بقوم البرنامج الأساسي باختيار البرامج الجزئية السابقة: يقوم بقراءة عددين عقديين ويجري العمليات 
الحسابيةء ثم يظهر النتائج بالشكل: 


(25.500+50.250 1) + (75.500+10,250 i) = (101.000+60.500 i ) 
(25.500+50.250 i) - (75.500+10.250 i) = (.......... i) 
(25.500+50.250 i) x (75.500-10.250 1) = (................... i) 
(25.500+50.250 i) / (75.500-10.250 1) = (................... i) 


TYPE 
COMPLEX-RECORD 
R:REAL; 
C: CHAR; 
I:REAL; 
END; 

VAR 
М1,М2,М3:СОМРІ ЕХ; 
R,F,X,Y:REAL; 
C,C1:CHAR; 

FUNCTION START(C:CHAR) : CHAR; 


BEGIN 

WRITELN( '------- 9-2-2 2-2 202 222 oon nnn enn nn nn nnn enn enn ne nn een ne ee en eee eee ee nee |'); 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 3: TO MUL TWO NUMBER PLEAS PRESS * DE 


| 

| 

| 

| 

| 1: TO SUM TWO NUMBER PLEAS PRESS + |"); 

| 

| 

| 

| 
WRITELN('| IDE 

| 

| 

| 

| 

| 

| 

| 

| 

| 


2: TO SUB TWO NUMBER PLEAS PRESS - I") 


WRITELN(' 4: TO DIV TWO NUMBER PLEAS PRESS / |'); 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 8: TO EXIT PLEAS PRESS E 
WRITELN ums ounces ner лана دمع عو‎ SRE ares ter anes СЫНОВ ©); 
WRITE(' ENTER THE ONE OF THE FOLOWING CHOICE '); 

READLN(C)3 

START : =С; 

END; 


5: TO CALULATE LENGTH OF COMPLEX NUMBER |Z| PRESS L |) 
6: TO CONVERT ANY COMPLEX NUMBER FORM DECART INTO TRONO FORM PRESS р 


1 
Е 
7: TO CONVERT ANY COMPLEX NUMBER FORM TRON INTO DECART FORM РКЕ55 Т ['); 
172 
I") 


PROCEDURE CREAD(VAR A:COMPLEX); 
VAR 
C: CHAR; 
BEGIN 
WRITELN('ENTER THE NUMBER IN THE FOLLOWING WAY: X «IY : و('‎ 
WRITELN('EX:3 +3'); 
READ(A.R,C,A.1); 
END; (END PROCEDURE] 
WRITELN('ENTER THE NUMBER IN THE FOLLOWING WAY: X «IY : '); 
WRITELN('EX:3 +3'); 
READ(A.R,C,A.1); 
END; (END PROCEDURE] 


FUNCTION CABS(A:COMPLEX) : REAL ; 

VAR 
S:REAL; 

BEGIN 
S:=SQRT((A.R*A.R) + (A.I*A.I)); (LENGTH OF COMPLEX NUMBER} 
CABS :=S 

END; {END FUNCTION } 


PROCEDURE Cadd(A1,A2:COMPLEX;VAR A3:COMPLEX) ; 
BEGIN 

АЗ.К:=А1.К+А2.К; 

АЗ.І:=А1.І+А2.1; 
END; {END PROCEDURE} 


PROCEDURE Csub(A1,A2:COMPLEX;VAR A3:COMPLEX) ; 
BEGIN 
A3.R:=A1.R-A2.R3 {VALUE X-R*COS(0)] 
АЗ.І:-А1.1-А2.1; (VALUE Y-R*SIN(O)] 
END; {END PROCEDURE] 


PROCEDURE CONV_TO_TRON(A1:COMPLEX;VAR R,O:REAL); 
VAR 
O1:REAL; 
BEGIN 
R:= CABS(A1); {R IS LENGTH OF COMPLEX NUMBER} 
O:-ARCTAN((A1.I/A1.R)); {PHASE} 
0:2((0*3.14)/(180)); (CONVERT PHASE TO RADEAN} 
END; {END PROCEDURE} 


PROCEDURE CONV TO DECART(R,O:REAL; VAR A:COMPLEX); 
VAR 
O1:REAL; 

BEGIN 

01:2(0*3.14)/(180); 

A.R:=R*COS(01); 

A.I:=R*SIN(01); 
END; {END PROCEDURE} 


PROCEDURE CMUL(A1,A2:complex;VAR A3:complex); 
VAR 
L1,L2, I, I1: INTEGER; 
R1,01,R2,02,R3,03:REAL; 
BEGIN 
CONV TO TRON(A1,R1,01); 
CONV TO TRON(A2,R2,02) ; 
R3:-R1*R2; 
03:-01-02; 
CONV_TO_DECART(R3,03,A3)3 
END; {END PROCEDURE} 


PROCEDURE CDIV (A1,A2:COMPLEX;VAR A3:COMPLEX); 
VAR 

01,02,03,R1,R2,R3:REAL; 
BEGIN 

CONV TO TRON(A1,R1,01); 

CONV TO TRON(A2,R2,02) ; 

R3:-R1/R2; 

03:=01-02; 

CONV_TO_DECART(R3,03,A3)3 
END; {END PROCEDURE} 
PROCEDURE CWRITE(A1,A2,A3:COMPLEX) ; 
BEGIN 

WRITELN('(',A1.R:2:2,'+',A1.1:2:2,' I',') ', С, '(',A2.R:2:2,'*' ,A2.1:2:2, 3 
Tg у» m у АЗ, 4 ,A3.1:222, . 1 و( ( بق‎ 
END; {END PROCEDURE} 


REPEAT 

C:=START(C); {MAIN MENU} 

IF С='+' THEN 

BEGIN 
CREAD(N1) ; 
CREAD(N2) ; {SUM TWO NUMBER } 
CADD(N1,N2,N3); 
CWRITE(N1,N2,N3); 

END; 


ТЕ C-'-' THEN 

BEGIN 
CREAD(N1); 
CREAD(N2);  ( SUB TWO NUMBER } 
CSUB(N1,N2,N3) ; 
CWRITE(N1,N2,N3); 

END; 


IF С='*' THEN 


BEGIN 
CREAD(N1) ; 
CREAD(N2); 4 MUL TWO NUMBER } 
CMUL (N1,N2,N3) ; 
CWRITE(N1,N2,N3); 

End; 


ТЕ C='/' THEN 

BEGIN 
CREAD(N1); 
CREAD(N2); { DIV TWO NUMBER } 
CDIV(N1,N2,N3); 
CWRITE(N1,N2,N3); 

END; {END IF} 


IF C IN['L','1'] THEN 
BEGIN 
CREAD(N1); (TO FIND LENGTH OF COMPLEX NUMBER] 


WRITELN('LENGTH OF [|',N1.R:2:2,' + ',N1.1:2:2,' I','|',' IS -',CABS(N1):2:2); 


END; {END IF} 


IF C IN['D','d'] THEN 


BEGIN {CONVERT ANY COMPEX NUMBER FROM DECART FORM INTO TRON FORM} 


WRITE('ENTER THE X=');READLN(N1.R)3 

WRITE('ENTER THE Y=');READLN(N1.1)3 

CONV_TO_TRON(N1,R,F)3 

WRITEEN('[* R:2:2,* , *yF22:2;"] ys 
END; {EN IF} 


IF C IN['T','t'] THEN 


BEGIN {CONVERT ANY COMPLEX NUMBER FROM TRON FORM INTO DECART FORM} 
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WRITE('ENTER THE R="); READLN(R); 
WRITE('ENTER THE PHASE -'); READLN(F); 
CONV TO DECART(R,F,N1); 
WRITELN(' E ,N1,R:2:2, NT. T:2:2,* T ",*)*)s 
END; {EN IF} 
IF C IN['E','e'] THEN 
BEGIN 
WRITE(' ARE YOU SURE TO EXIT ,TYPE Y/N ?'); 


READLN(C1) 3 

END; 
UNTIL ((C IN['E','e']) AND (сі IN['Y','y']))3 
END. 

READLN(C1) ; 

END; 
UNTIL ((C IN['E','e']) AND (сі IN['Y','y'])); 
END. 
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°3 المسألة‎ 
Е انيل‎ es let OREN сін يده‎ e Cr ea abet ad في ف‎ calo 


Type date= Record 
Year,day,mounth: integer; 
end ; 


المطلوب كتابة البرامج الجزئية التالية : 

:Set Date‏ بالنمط تاريخ ثلاث قيم صحيحة تمثل اليوم والشهر والسنة والعام. 

31/10/1999 يظهر التاريخ على الشاشة بالشكل المألوف» أي‎ :WriteDate 

ati : GreaterDate‏ منطقي يقارن بين تاريخين ويعطي القيمة صح إن كان الأول أكبر تماماً من الثاني. 
bs :BetweenDate‏ الفرق بين تاريخين. 


يقوم البرنامج الأساسي باستدعاء البرامج الجزئية السابقة واختيارها. 


TYPE 
DATE=RECORD 
DAY: INTEGER; 
MONTH: INTEGER; 
YEAR: INTEGER; 
END; 


VAR 

DAT1,DAT2:DATE; 

Е: BOOLEAN; 

PROCEDURE READDATE(VAR D1:DATE); 
VAR S,SLASH:CHAR; 


BEGIN 


WRITE('ENTER THE DATE ON THE FOLLOWING WAY : DAY /MONTH /YEAR:'); 
READLN(D1.DAY, S, SLASH,D1.MONTH, S, SLASH,D1. YEAR) ; 
END; 


PROCEDURE WRITEDATE(D1:DATE); 
BEGIN 

WRITELN('THE DATE IS :',D1.DAY, ' /' ,D1. MONTH, ' /' ,D1. YEAR) ; 
END; 


FUNCTION GREATERDATE(D1,D2:DATE) : BOOLEAN; 
VAR RESULT :BOOLEAN; 
BEGIN 
RESULT :=FALSE; 
IF D1.YEAR>D2.YEAR THEN 
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RESULT : ZTRUE 
ELSE IF D1.YEAR=D2.YEAR THEN 
IF D1.MONTH>D2.MONTH THEN 
RESULT: Z TRUE 
ELSE IF D1.MONTH=D2.MONTH THEN 
IF D1.DAY>D2.DAY THEN 
RESULT :=TRUE 3; 


GREATERDATE :=RESULT} 
END; 


PROCEDURE BETWEENDATE(D1,D2:DATE); 
VAR D3:DATE; 
BEGIN 
D3. YEAR: =D1.YEAR-D2.YEAR; 
D3.MONTH:=D1.MONTH-D2.MONTH; 
D3.DAY:=D1.DAY-D2.DAY; 
(WRITELN('THE DIFFERENCE BETWEEN TWO DATE IS : ',D3.DAY, '/' ,D3.MONTH, '/' ,D3. YEAR) ;} 
WRITELN('THE DIFFERENCE BETWEEN TWO DATE IS : ',D3.YEAR,' YEARS',' AND ',D3.MONTH,' MONTH',' AND 
' ,D3.DAY,' DAY'); 
END; 


ELSE IF D1.YEAR=D2.YEAR THEN 
IF D1.MONTH>D2.MONTH THEN 
RESULT: 2TRUE 
ELSE IF D1.MONTH=D2.MONTH THEN 
IF D1.DAY>D2.DAY THEN 
RESULT :=TRUE; 
GREATERDATE :=RESULT} 
END; 
PROCEDURE BETWEENDATE(D1,D2:DATE); 
VAR D3:DATE; 
BEGIN 
D3.YEAR:=D1.YEAR-D2.YEAR; 
D3.MONTH:=D1.MONTH-D2.MONTH; 
D3.DAY:=D1.DAY-D2.DAY; 
(WRITELN('THE DIFFERENCE BETWEEN TWO DATE IS :',03.РАУ, '/',03.МОМТН, '/',D3. YEAR) ;} 
WRITELN('THE DIFFERENCE BETWEEN TWO DATE IS : ',D3.YEAR,' YEARS',' AND ',D3.MONTH,' MONTH',' AND 
' D3.DAY, ' DAY'); 
END; 
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المطلوب فى هذه الفسالة حساب علامات الطاب ر إصدار ей ñ‏ 


يُعرّف كل طالب برقم ذاتي ме)‏ صحيح «(саз sa‏ واسم(سلسلة حرفية لا تتجاوز 25حرفاً )» إضافة إلى 
علامات المواد: رياضيات € dae ji‏ لغة АА] (Ар ус‏ أجنبية. تُحسب العلامة من100. 

المطلوب قراءة المعلومات الخاصة بالطلاب وعلاماتهم» وحساب معدلاتهم وإصدار قوائم العلامات ملاتبة 
وفق المعدلات. كما يطلب حساب وسطي العلامات والانحراف المعياري في كل مادة. 


type 
studentmark=record 
math: integer ; 
programing: integer; 
arabic:integer; 
end; 


student=record 
serialnumber: integer; 
name: string[15]; 
stdmark:studentmark; 
average:real; 
leavel:string; 


end; 
var 

std mark:array[1..100] of student; 

n,i,j:integer; temp: student; 

s math,s programing,s агаріс,5 all,s lest : set of 1..100; 
begin 
var 

std mark:array[1..100] of student; 

n,i,j:integer; temp: student; 

s math,s programing,s агаріс,5 all,s lest : set of 1..100; 
begin 


write(' enter the number of student:-'); readln(n); 
for i:- 1 to n do 


begin 
writeln('enter the data of student  ',i); 
writeln('------------------------------- 9; 
with std_mark[i] do 
begin 


write('enter the serial number-'); 
readln(serialnumber); 

write(' enter the name of the student: '); 
readln(name); 
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write(' enter the grade of math='); 
readln(stdmark.math); 
write(' enter the grade of programing-'); 
readin(stdmark.programing); 
write(' enter the grade of arabic='); readln(stdmark.arabic); 
end; 
writeln('------------------------------- '); 
end; 
s math:z[]; 
s programing:z[]; 
s_arabic:=[]; 
s all:s[]; 
s_lest:=[]; 


for i:= 1 to n do 
begin 
if std mark[i].stdmark.math»-60 then 
s math:zs mathe[std mark[i].serialnumber]; 
if std mark[i].stdmark.programing»-60 then 
5 programing:- s programinge[std mark[i].serialnumber]; 
if std_mark[i].stdmark.arabic>=60 then 
s_arabic:=s_arabic+[std_mark[i].serialnumber] ; 
end; 


s_lest:=s_math+s_programing+s_ arabic; 

s_all:=s_math*s_programing*s_arabic; 

ј:=1; 

writeln('sn':10,'name':10, 'math':10, 'programing':20, 'arabic':10); 
end; 

s_lest:=s_math+s_programing+s_ arabic; 

5 а11:-5 math*s programing*s arabic; 

ј:=1; 

writeln('sn':10,'name':10, 'math':10, 'programing':20, 'arabic':10); 

while ((j<=n) and (s lest«»[])) do 


begin 
if ( std mark[j].serialnumber in s lest) then 
begin 
with std mark[j] do 
begin 
writeln(serialnumber:10,name:10,stdmark.math:10,stdmark.programing:20,stdmark.arabic:10); 
end; 
5 1е5%:-5 lest-[std mark[j].serialnumber]; 
end; 
j:=j+1; 
end; 


for i:= 1 to n do 
begin 
std_mark[i].average:=0; 
if std_mark[i].serialnumber in s_all then 
begin 
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with std_mark[i] do 


std_mark[i].average:=((stdmark.math+stdmark.programing+stdmark.arabic) /3) ; 


case round(std_mark[i].average) of 
60..69: std_mark[i].leavel:='good'; 
70..79: std_mark[i].leavel:='very good'; 
80..100:std mark[i].leavel:z'exclent'; 


end; 
end 
else 
std mark[i].average:-20; епа; í End For LOOP} 
end; 
for i:= 1 to n-1 do 
begin 
for j:=i+1 to n do 
begin 
if std_mark[i].average>std_mark[j].average then 
begin 
temp:=std_mark[i]; 
std mark[i]:-std mark[j]; 
std mark[j]:-temp; 
end; 
end; 
end; 
writeln('------------------- ',' students sorting ' ,'------------------------- '); 


writeln('sn':10,'name':10,'math':10, 'programing':20, 'arabic':10, 'average' :10, ' leavel':10); 


for i:- 1 to n do 
begin 
with std mark[i] do 


write(serialnumber:10,name:10,stdmark.math:10,stdmark.programing:17,stdmark.arabic:10,average:12:2,' 


':4,1еауе1); 


епа. 


writeln; 
end; 
readin; 


المسألة 95 76 
المطلوب كتابة الإجرائيات التالية: 


1. إجرائية تحسب عدد الكلمات في كل سطر. 


3. إجرائية إستبدال كلمة 70101(موجودة في النص) بكلمة .WOrd2‏ 
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إجرائية عدد GLAST)‏ في كل سطر 


procedure num_words(var A:text; var nw:integer) ; 


Var 


Begin 


End; 


c:char; l:integer; 


Assign(A, 'c:\textfile'); 


reset(A); 
While not eof(A) do 
Begin 
read(A,c); 
пм: =9; 
1:=1+1; 
While not eoln(A) do 
Begin 
While (ord(c)=32) do 
Begin 
read(A,c); 
if (ord(c) in [65..90,97..122]) then 
nw: =nw+1 5 
End; 
read(A,c); 
End; 
writeln('the number of word in the line ',1 ,' is -', nw); 
End; 


إجرائية عدد مرات تكرار كلمة في نص ضمن الملف: 


procedure word_freq(Var A:text; word:string; var r:integer); 


Var 


Begin 


c:char; s:string; 


Assign(A, 'c:\textFile'); 


reset(A); 
While not eof(A) do 
Begin 
read(A,c); 
giar"; 
while not eoln(A) do 
Begin 
while (ord(c)<>32) do 
Begin 
S:-S4C; 
read(A,c); 
End; 
if s-word then 
ri=r+1; 
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Read(A,c); 
End; 
End; 


End; 
word2 346; النص)‎ 3335» s) word] إجرائية إستبدال كلمة‎ 


procedure replace word(Var A,B:text; word1,word2:string) ; 
Var 
c:char; s:string; 
Begin 
Assign(A ,'c:\A "); 
reset(A); 
Assign(B,'c:Mb'); 
rewrite(B); 
While not eof(A) do 
Begin 
read(A,c); 
Ss. 
while not eoln(A) do 
Begin 
while (ord(c)«»32) do 
Begin 
write(B,c); 
S:-S4C; 
read(A,c); 
End; 
if s=word1 then 
write(B,word2); 


Read(A,c); 


End; 
End; 
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المسألة 7: 


المطلوب قراءة ملف نصي وكتابته في ملف نصي آخر بعد تحويل كل حرف صغير فيه إلى حرف كبير. 


VAR 


BEGIN 


END. 


T1,T2:TEXT; 
C,C1:CHAR; 
ORDE: INTEGER; 


АЅЅІСМ(Т1, 'С:\5 LETTER. TXT'); 
ASSIGN(T2, 'C:NC LETTER. TXT'); 
REWRITE(T1); 
WRITELN(' ENTER THE TEXT WHICH END WITH . '); 
WHILE C«»'.' DO 
BEGIN 
READ(C); 
WRITE(T1,C); 
END; 
CLOSE(T1); 
RESET(T1); 
REWRITE(T2); 
WHILE NOT(EOF(T1)) DO 
BEGIN 
READ(T1,C); 
ORDE : =ОВО(С) ; 
CASE ORDE OF 


97..122 : BEGIN C1:=CHR(ORDE-32); 
65..90 : WRITE(T2,C); 
ELSE 
WRITE(T2,C); 
END; 
END; 
CLOSE(T1); 
CLOSE(T2); 
RESET(T2); 


WRITE(T2,c1); END; 


WRITELNC ЕЕ EE SEE EE EEE op o poop ens 


WRITELN( ЕР КЕ ғ ТНЕ TWO TEXT ааа дада Ее уа 


WRITE LIN ("> aak a aak ak ate жж Жжжж ЖЖ ЖЖ ЖЖЖ ЖЖ ЖЖ ж ЖЖ ЖЖ ЖЖ ЖЖЖЖ ЖЖЖ ЖЖЖЖ t) ; 


CLOSE(T2); 
RESET(T2); 


NRITELN( REE ЯК ЕЕ ЕТК), 


МЕТЛТЕШМ( Exo ERR ee ees THE TWO TEXT ыы ا‎ ны. 


WRETELNG "ЕЕ EELS КА EEE HE EROR ЖЕ ККЕ و ا‎ 


WHILE NOT(EOF(T2)) DO 


BEGIN 
READ(T2,C); 
WRITE(C); 

END; 

CLOSE(T2); 

READLN; 

READLN; 
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المسألة 8: 
اكتب برنامجاً يقوم بالعمليات التالية: 
أ- الخزن في ملف ثنائي لمعطيات تعريف الكتب في مكتبة. يوصف الكتاب برقم تسلسلي» وعنوان 
واسم al gall‏ وتاريخ الإصدارء لإضافة إلى dia‏ منطقي يدل على الإعارة» يقوم البرنامج بقراءة 
المعلومات من ملف معطيات نصي. 


ب- تسجيل الإعارة أو الإعادة في الملف. يقوم المستخدم بإعطاء جدول بأرقام الكتب المعارة والمعادة 
ليسجلها البرنامج على الملف. 
ت- إظهار لائحة بالكتب المعارة. 


TYPE DATE=RECORD 
DAY: INTEGER; 
MONTH: INTEGER; 
YEAR: INTEGER; 

END; 
LIB=RECORD 
SN: INTEGER; 
TITEL : STRING[ 7]; 
NAME : STRING[8] ; 
DAT:DATE; 
BORROW: BOOLEAN; 
END; 
BOR-RECORD 
BORROW: INTEGER; 
NOTBORROW: INTEGER; 


END; 

VAR 
BF,B1:FILE OF LIB; Т1:ТЕХТ; 
D1:DATE; TEMP,R:LIB; 
C: CHAR; 
A:ARRAY[1..100] OF BOR; I,N:INTEGER; 
S N:SET OF 1..100; B:BOOLEAN; 
S$1,S2:STRING[7]; 

BEGIN 


ASSIGN(BF, 'k:\LIBRARAY' ) ; 
ASSIGN(T1, 'К:\Т1.ТХТ'); 
ASSIGN(B1, 'К:\ТЕМР'); 
RESET(T1); 
REWRITE(BF); (1) 
WHILE NOT(EOF(T1)) DO 
BEGIN 
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READLN(T1,R.SN,R.TITEL,R.NAME,R.DAT.DAY , R. DAT. MONTH, R.DAT. YEAR) ; 


WRITE(BF,R); 
END; 
CLOSE(T1); 
CLOSE(BF); 


RESET(BF); 

REWRITE(B1); 

WHILE NOT(EOF(BF)) DO 

BEGIN 

READ(BF,R); (SWAP BETWEEN TWO FILES] 
WRITE(B1,R); 

END; 

CLOSE(BF); 

CLOSE(B1); 


CLOSE(BF); 
CLOSE(B1); 


6 Мі-|1; 

REWRITE(BF); 

RESET(B1); 

WRITE('ENTER THE NUMBER OF BOOKS '); READLN(N); 


WRITELN('ENTER THE NUMBERS OF THE BOOKS WITCH BORROW '); 


WRITELN('ENTER THE 


FOR I:-1 TO N DO (2) 
BEGIN 
WRITE('THE BOOK ',I,'=')3 
READLN(A[I].BORROW) ; {READING LIST 1} 
WHILE (NOT(EOF(B1))AND (A[I].BORROW«»TEMP.SN)) DO 
BEGIN 
READ(B1,TEMP); 
IF TEMP.SN-A[I].BORROW THEN 
BEGIN 
TEMP . BORROW: z TRUE ; (3) 
WRITE(BF,TEMP); 
S N:-S N«[TEMP.SN] 
END; 
END; {END WHILE} 
END; {END FOR} 
{ cte SE 
NUMBERS OF THE BOOKS WITCH NOTBORROW '); 
FOR I:-1 TO N DO 
BEGIN 
WRITE('THE BOOK ',I,'-'); (READING LIST 2} 


READLN(A[I].NOTBORROW) ; 
END; {END FOR} 
CLOSE(B1); 
CLOSE(BF); 


мгікеіп("------------------------------------------------------------- 


WRITE('ENTER THE ADDRESS OF THE BOOK WHICH YOUSEARCH IT :'); 


READLN(S1); 


RESET(B1); 
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REPEAT 
S1:-' '4S1; 
UNTIL LENGTH (51)-7; 
IF R.TITEL=S1 THEN 
IF R.SN IN S N THEN 
WRITELN('THE BOOK  ',S1,' CAN NOT BE BORROWED ' ) 
ELSE 
WRITELN('THE BOOK ',51,' CAN BE BORROWED'); 
WHILE ((NOT(EOF(B1))) AND (S1<>R.TITEL)) DO 
BEGIN 
READ(B1,R); {4} 
IF R.TITEL=S1 THEN 
IF R.SN IN S_N THEN 
WRITELN('THE BOOK ",51," САМ МОТ BE BORROWED ') 
ELSE 
WRITELN('THE BOOK ',S1,' CAN BE BORROWED') 
END; 
CLOSE(B1); 


writeln('----------------------------------------------------------- Pr 
WRITELN('ENTER THE DATE '); 
WRITELN('---------------- "ys 
WRITE('ENTER THE DAY='); READLN(D1.DAY); 
WRITE('ENTER THE MONTH-'); READLN(D1.MONTH); 
WRITE('ENTER THE YEAR-'); READLN(D1.YEAR) ; 
RESET(B1); 
WRITELN(' THE BOOK WHITCH ARE CREATER BEFOR DATE ',D1.DAY,'V' ,D1.MONTH, 'V',D1. YEAR, ' :'); 
pau fo c aa E 9; 
WHILE NOT(EOF(B1)) DO 
BEGIN 
READ(B1,R)3 
B:=FALSE; {5} 
IF D1.YEAR>R.DAT.YEAR THEN 
B:=TRUE 
ELSE IF D1.YEAR=R.DAT.YEAR THEN 
IF D1.MONTH>R.DAT.MONTH THEN 
B:=TRUE 
ELSE IF D1.MONTH=R.DAT.MONTH THEN 
IF D1.DAY>R.DAT.DAY THEN 
B:=TRUE; 
IF B=TRUE THEN 


WRITELN(R.SN,C,R. TITEL,C,R. NAME, C, R. DAT. DAY: 2, R. DAT. MONTH: 4, R. DAT. YEAR: 8 ,R. BORROW: 8) ; 
END; 
BEGIN/ * } 
READ(B1,R); 
B:-FALSE; (5) 
IF D1.YEAR>R.DAT.YEAR THEN 
B:=TRUE 
ELSE IF D1.YEAR=R.DAT.YEAR THEN 
IF D1.MONTH>R.DAT.MONTH THEN 
B:=TRUE 
ELSE IF D1.MONTH=R.DAT.MONTH THEN 
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IF D1.DAY>R.DAT.DAY THEN 
B:=TRUE; 
IF B=TRUE THEN 
WRITELN(R.SN,C,R.TITEL,C,R.NAME,C,R.DAT.DAY:2,R.DAT.MONTH:4,R.DAT.YEAR:8,R.BORROW:8) ; 
END; {End *} 
RESET(BF); 
WRITELN(' THE BOOKS WHICH ARE BORROWED IN THE LIBRARAY IS....'); 
WHILE NOT(EOF(BF)) DO 
BEGIN (PRINT LIST] 
READ(BF,R); 
WRITELN(R.SN,C,R.TITEL,C,R.NAME, C, R.DAT.DAY:2,R.DAT.MONTH:4,R.DAT.YEAR:8,R. BORROW:8) ; 
END; 
CLOSE(BF); 
WRITELN('-------------------------------------------------------------- "9% 
RESET(B1); 
WHILE NOT(EOF(B1)) DO 
BEGIN (PRINT LIST] 
READ(B1,R); 
WRITELN(R.SN,C,R.TITEL,C,R.NAME, C, R.DAT.DAY:2,R.DAT.MONTH:4,R.DAT.YEAR:8,R. BORROW:8) ; 
END; 
CLOSE(B1); 
READLN; 
END. 
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لدينا ملفان ثنائيان من alae YI‏ الصحيحة مرتبان تصاعدياًء نريد دمجهما dya‏ نحصل على ملف واحد 
كبيرين cas‏ وهذا مانسميه بالفرز الخارجي. 

اكتب أولاً برنامجاً ينشئ الملفات الثنائية من ملفات نصية تحوي أعداداً صحيحة. 

ثم اكتب برنامج الدمج الذي ينشئ الملف الثنائي الناتج» ثم نقوم بكتابته Laj‏ في ملف نصي. 


Procedure merge2file(var inl,in2:text; var out:text); 
Var 
n1,n2:integer; 
Function getvalue (var f:text):integer; 
Var n :integer; 
Begin 
if not eof(in1)then 
Read(f,n) 
Else 
N:=maxint; 
Getvalue:zn; 
End; 
Begin 
Reset(in1); 
Reset(in2); 
Rewrite(out); 
N1:2getvalue(in1); 
N2:-getvalue(in2); 
While (n1« maxint) or (n2 «maxint) do 
If ni«n2 then 
Begin 
Write(out,n1); 
N1:=getvalue(in1); 
End 
Else 
Begin 
Write(out,n2); 
N2:=getvalue(in2); 
End; 
Close(in1); 
Close(in2); 
Close(out); 
End; 
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المطلوب بناء برنامج لتحقيق لائحة معطيات 4a 53 за‏ الترابط()115 «(double linked‏ باستخدام بنية تحوي 
مؤشرين У‏ من مؤشر واحد كما في اللائحة أحادية الترابط e‏ مؤشر إلى العنصر السابق ومؤشر إلى 
العنصر اللاحق. كما نستخدم مؤشرين الأول يشير إلأى الرأس والثاني إلى الذيل. 


Type 


Dl pz^Dl г; 

Dl г-гесога 
key:integer; 
next:Dl p; 
last:Dl p; 

End; 


procedure insert(var ls,le:Dl p; key:integer) ; 


var 


begin 


temp,s:Dl p; 
located:boolean; 


new(temp); 
temp^.key:zkey; 
temp^.next:znil; 
temp^.last:-nil; 
if ls-nil then 


Begin 
ls:-temp; 
le:=temp; 
End 
Else 
Begin 
Begin 
s:=ls; 


located:=false; 
while ((s<>nil) and (not(located))) do 
if s*.key<key then 
s:=s*.next 
Else 
located:=true; 
temp^.next:-s; 
if 5-15 then {} 


Begin 
temp^.next:-1s; 
ls:-temp; 
End 
Else 
Begin 
if s-nil then 
Begin 
le^.next:-temp; 
temp*.last:=le; 
le:=temp; 
End 
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End; 
End; 
End; 


Else 


Begin 
temp*.last:=s*. last; 
s*.last:=temp; 
temp^.last^.next:-temp; 
End; 


procedure Delete(var 1s,le:Dl p; key:integer) ; 


var temp,s:Dl p; 
Begin 
if ls-nil then 


writeln('the Double linked list is Empty') 


Else 


if 1s*.key=key then 


Begin 


End 
Else 
Begin 


End; 


End; 


End; 
End; 


temp:-1s; 
15:=15^.пехі; 
015ро$е (Фетр); 


if 1е^.Ккеу=кеу then 


Begin 
temp:=le; 
Іе:=1е^.1аѕі; 
le^.next:znil; 
Dispose(temp); 
End 
Else 
Begin 
5:=15; 
while ((s«»nil) and (s^.key«»key)) do 
s:=s*.next; 
if s=nil then 
writeln('the Element is not found in the list') 
Else 
Begin 
s^.last^.next:-s^.next; 
s^.next^.last:-s^.last; 
Dispose(temp); 
End; 
End; 
End; 
End; 
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المساله 11: 
تتعامل مسألتنا مع ما يسمى "المصفوفات المثقوبة"» وهي مصفوفات تغلب فيها القيمة صفرء فمحدودة هي 
القيم المختلفة عن الصفر.ويهدف إلى الاختصار في الذاكرة اللازمة لمصفوفات كبيرة من هذا cE gill‏ 
سنستخدم المؤشرات المرسومة في الشكل المرفق» والمعرّفة كما يلي: 
Const MaxN= 100;‏ 
Type PEMAT= ^EMAT;‏ 
Type EMAT- record‏ 
Begin‏ 
Col: integer;‏ 
Var: real;‏ 
Penxt: PEMAT;‏ 
End‏ 
Type HoleMat= array [1..MaxN] of PEMAT;‏ 


وبهذا تكون المصفوفة جدولاً من المؤشرات يؤشر كل منها إلى سلسلة العناصر غير الصفرية في سطر 
المصفوفة» ويكون عنصر المصفوفة Siaa‏ بتسجيلة» عناصرها: رقم العمود وقيمة العنصر ومؤشر إلى 
عنصر أخرفي السطر نفسه.الصورة التالية تبين تمثيل مصفوفة مثقوبة باستخدام المؤشرات. 


والآن وقد عرفنا طريقة تعريف نمط المصفوفة يطلب كتابة البرامج الجزئية التالية: 
+12 ييقرؤوأ عناصر المصفوفة من الدخل ويخزنها في متحول من نمط .HoleMat‏ 


2 يكتب مصفوفة من النمط HoleMat‏ (العناصر المختلفة عن الصفر فقط). 
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:AddHMat‏ يجمع مصفوفتين من النمط HoleMat‏ ويضع الناتج في مصفوفة من النمط ذاته. 
:SumHMat‏ يجمع جميع palic‏ مصفوفة من .HoleMat ball‏ 
224 : يعطي العنصر الأكبر بين عناصر مصفوفة من .HoleMat baill‏ 


اكتب الآن البرنامج الأساسي الذي يستدعي البرامج الجزئية السابقة ويختبر جيداً صحة عملها. 


Const МахМ-100; 
Type Pematz^Emat; 
Emat=Record 
Col: integer; 
Val:Real; 
Pnext:Pemat ; 
End; 
Holmat=Array[1..maxn] of pemat; 
Var 
1s: pemat; 
n,m,i:integer; 
h mat,h mati,h mat2,h mat3,h mat4,h mat5:holmat; 


PROCEDURE SPACE; 
VAR 
I:INTEGER; 
BEGIN 
FOR I:- 1 TO 100 DO 
WRITELN; 
END; {END PROCEDURE} 


PROCEDURE MENU(VAR C:CHAR); 
BEGIN 
SPACE; 
Иг1їїе1п('|----------------------------------------------------------------- - 
Writeln('| 
Writeln('| 
Writeln('| 
Writeln('| 
Writeln('| 
Writeln('| 
Writeln('| 
Writeln('| | MAIN MENU | 
| 
| 
| 
| 
| 
| 
| 


ve е. 


WELCOME IN MATRIX HOLED PROGRAM 


we we we 


WHAT DO YOU WANT TO DO ? 


“. 


. `. 


we 


Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 


e ve ve 


1: To Read Array Elements. 


ve ve we 


Ne ewe М w М w w w اتا‎ М تا ات اتا تا‎ w 
“ 


“. 


2: To Print Array Elements. 
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Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 


| 
| 
| 3: To Sum Two Array. 
| 
| 
| 
Writeln('| 
| 
| 
| 
| 
| 
| 


4: То Sum Elements of Array. 


Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
игїїе1п('|----------------------------------------------------------------- 
Writeln(' ENTER ONE OF THE FOLOWING CHOICES '); 

Readl1n(C); 

Епа; {End Procedure} 


5: To Get Max Elements in Array . 


6: TO EXIT FROM PROGRAM. 


Procedure Insert(Var ls:pemat; R:emat); 
Var t,p,prev:pemat ; 
Begin 
New(t); 
t^:zR; 
t^.Pnext:zNil; 
If Ls=Nil Then 
Ls:-t 
Else {*} 
Begin 
If t^.Col«ls^.Col Then 
Begin 
t^.Pnext:-1s; 
ls;=t; 
End 
Else {**} 
Begin 
p:=Ls; 
while ((p<>Nil) And (t^.Col»p^.Col)) Do 
Begin 
ргеу:-р; 
p:zp^.Pnext; 
End; 
If (t^.Col«»p^.Col) Then 
Begin 
t^.Pnext:zp; 
prev^.Pnext:zt; 
End 
Else 
p*.val:=p*.val+t*.val; 
Епа; {Епа **} 
Епа; {Епа *} 
Епа; {Епа Procedure} 


Procedure Readline h mat(Var ls:pemat; n:integer) ; 


° 4. 4... 


eo we 4. ve 


“. 


МУ МУ ve МУ www" WH М w w — — — 
` 


`. 


— س‎ w 


we 


we 


“. 
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Var R:emat; 


Begin 
Writeln(' To Start Press Enter , But To Exit press CTRL+Z ... '); 
While Not Eof Do 
Begin {1} 
Readln; 
Repeat 


Write('Enter The Column number ='); Readln(R.Col); 
Until R.col<=n; 
Repeat 
Write('Enter The value-'); Readln(R.Val); 
Until К.уа1<>0; 
Insert(ls,R); 
Writeln(' To Continue Press Enter , But To Exit press CTRL4Z ... '); 
End; {End While} 
Епа; {End Procedure} 


Procedure Read_holmat(Var hol:Holmat; m,n:integer); 
Var i:integer; 
Begin 
For i:- 1 To m do 
Begin 
Writeln('Enter the element of line 
Readline h mat(hol[i],n); 
End; {End For} 
End; {End Procedure} 


i); 


Procedure Add hmat(holi,hol2:holmat; Var hol3:holmat; m,n:integer ); 
Var i:integer; R:Emat; p1,p2:Pemat; 
Begin 
For i:- 1 to m do 
hol3[i]:=nil; 
For i:= 1 to m do 
Begin {Merge to List j if (pi^.col-p2^.coL) then sum between then} 
hol3[i]:=nil; 
For i:= 1 to m do 
Begin {Merge to List ; if (p1%.col=p2%.col) then sum between then} 
pl:-holi[i]; р2:-һо12(11; 
While ((pi«»nil) or (p2<>nil)) do 
Begin 
if р1^.со1=р2^.со1 then 
Begin 
R.Val:z((p1^.Val) + (p2^.Val)); 
К.Со1:=р1^.Со1; 
insert(hol3[i],R); 
р1:-р17.рпех%; 
p2:-2p2^.pnext; 
End 
Else 
if p1^.Col«p2^.Col then 
Begin 
К: =р1^; 
Insert(hol3[i],R); 
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p1:=p1*%.pnext; 
End 
Else 
if p2^.Col«p1^.Col then 
Begin 
К:=р2^; 
Insert(hol3[i],R); 
p2:2p2^.pnext; 
End; 
Епа; {Епа While} 
Епа; {Епа For} 
Епа; {Епа Procedure} 
Procedure sum_Elements(hol:holmat; m:integer; Var Sum:Real ); 
Var i:integer; p:pemat; 
Begin 
Sum:=0; 
For i:= 1 to m do 
Begin 
p:=hol[i]; 
While p<>nil do 
Begin 
sum:=sum+p*.val ; 
p:=p*.pnext; 
End; {End While} 
End; {End For} 
End; {End Procedure} 


Procedure Greatest(hol:holmat; m:integer; var great:Real); 
Var i:integer; p:pemat; 
Begin 
great:=0; 
For i:= 1 to n do 
Begin 
p:=hol[i]; 
While p<>nil do 
Begin 
if p^.val»great then 
great:=p*.val; 
p:=p*.pnext; 
End; {End While} 
End; {End For} 
End; {End Procedure} 
Procedure Display(Var hol:holmat; m,n:integer) ; 
Var i,j:integer; 


p:pemat; 
Begin 
For 1:= 1 Tom do 
Begin 
p:=hol[i]; 


For j:= 1 To n do 
If (((p«»nil) or (p=nil)) and(j«»p^.col)) then 
Write(0:6) 
Else 
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Begin 
Write(p^.val:6:2); 
p:=p*.pnext; 
End;{End Else} 
Writeln; 
End; {Епа For} 
End; {End Procedure} 
Беріп Еж ж ж а жж ESE AGT N РРОДРАОПЕЕЕЕ ЖЖ ЖЖ ЖЖЖ) 
Repeat 
Menu(c); 
Case C of 
UL os 
Begin 
Write('Enter the line number="); Readln(m); 
Write('Enter the column numberz'); Readln(n); 
For i:- 1 To m Do 
h_mat[i]:=nil; 
Read holmat(h mat,m,n); 


Write('Press Enter To main Menu....... “у 
Readln; 
End; 
"274 
Begin 
Display(h mat,m,n); 
Write('Press Enter To main Menu....... "ys 
Readln; 
End; 
АСЛЫ 
Begin / First Array} 
Writeln(' Enter the First Array...... PYS 
Writeln('-------------------------------------------- و(‎ 
Write('Enter the line number For Two Array [A] & [B] ;  Readln(m); 


2) 
Write('Enter the column number For Two Array [A] & [B] ='); Readln(n); 
For i:- 1 To m Do 
h_mati[i]:=nil; 
Read_holmat(h_mati,m,n) ; 
{ Second Array } 
Writeln('Enter the Second Array....... 95 
Writeln('-------------------------------------------- "ys 
{ Write('Enter the Line numberz'); ReadLn(m); 
Write('Enter the column number-'); ReadLln(n);j 
For i:- 1 To m Do 
h mat2[i]:znil; 
Read holmat(h mat2,m,n); 
{ Result Array [A]+[B]} 


Add_hmat(h_mat1,h_mat2,h_mat3,m,n); {Sum Procedure} 
Writeln( “жж жет а First Array [A] евинин ys 
Writeln('-------------------------------------------- ку; 
Display(h mati,m,n); 

Writeln( "ЭЖ а Second Array [B] £3 ЕРЕЖЕ ЖЕ 
Writeln('-------------------------------------------- "js 
Display(h mat2,m,n); 
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Writeln('***eee*The Result Array [A]+[B]************'); 
Writeln('-------------------------------------------- “ук 
Display(h mat3,m,n); 
Write('Press Enter To main Menu....... "9% 
Readln; 
End; 
Writeln('-------------------------------------------- D 
Display(h mat3,m,n); 
Write('Press Enter To main Menu....... “9; 
Readln; 
End; 
'4': 
Begin 
Write('Enter the line number-'); Readln(m); 
Write('Enter the column number='); Readln(n); 
For i:- 1 To m Do 
h_mat4[i]:=nil; 
Read holmat(h mat4,m,n); 
sum Elements(h mat4,m,s); 
Display(h mat4,m,n); 
Writeln( "Жж The Array is ЖЖЖ КЖ ys 
Writeln('-------------------------------------------- "93 
Writeln(' The Sum Element of Array is -",5:4:2); 
Write('Press Enter To main Menu....... ys 
Readln; 
End; 
Б 
Вер1п 
Write('Enter the line питрег='); Readln(m); 
Write('Enter the column number='); Readln(n); 
For i:- 1 To m Do 
h_mat5[i]:=nil; 
Read holmat(h mat5,m,n); 
greatest(h mat5,m,g); 
Writeln( ЭЖ жж The Array is TE eee ER. s 
Writeln('-------------------------------------------- "sS 
Display(h mat5,m,n); 
Writeln(' the Greatest Element in This Array is :',g:4:2); 
Write('Press Enter To main Menu....... "s 
Readln; 
End; 
Епа; {End Case} 
until c-'6'; 
End. 
Write('Press Enter To main Menu....... ШІН 
Readln; 
End; 
Епа; {Епа Case} 
until c-'6'; 
End. 
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المسألة 13: 
يمكن تمثيل كثير الحدود بجدول array‏ نخزن فيه أمثال كثير الحدود وبعددصحيح يمثل cain уз‏ ولنضع حداً 
أعظم لدرجة كثير الحدود القيمة 30. 
يمكن أن نعرف نمط كثير الحدود Polynom‏ كمايلي: 
Type Polynm= record‏ 
Begin‏ 
Cof: array [0..30] of real degree: integer‏ 
End;‏ 
وهكذا لتمثيل жө‏ الحدود 1+ 3x10‏ في متحول (var p: polynom) .p‏ نقوم بعمليات الإسناد : 
p.degree: =10;‏ 
For i:= @ to 10 do‏ 
p. cov [i] :=0;‏ 
p.cov[0] := 1;‏ 
p.cov[10] := 3;‏ 
والأن قد استوعبنا تعريف نمط كثير الحدودء المطلوب هو كتابة وحدة برمجية unit‏ تتضمن تعريف Lall‏ 
ومجموعة البرامج الجزئية التالية التي تتعامل معه: 
:Real Pol‏ تعريف يقرأ كثير الحدود من الدخل» يعطى الدخل بإعطاء الدرجة والمثل لكل حد مختلف عن 
الصفر. 
201 يريكتب كثير ca gaat)‏ ويظهر الحد بالشكل (хххххх.хх)Х^п‏ للحدود غير الصفرية as hä‏ 
بالحسبان كتابة كثير الحدود الطويل على أكثر من سطر. 
01 يعطي لكثير الحدود ¢ القيمة صفر. 
AdPol‏ : يجمع كثير الحدود» ويضع النتائج في كثير حدود آخر. 
:SubPol‏ يطرح كثير الحدود» ويضع الناتج في كثير حدود آخر. 
:ProdPol‏ يضرب كثير الحدود» ويضع التتائج في كثير حدود آخر. 


اكتب برنامجاً يستخدم الوحدة البرمجية السابقة ويختبر جميع عملياتها. 
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Type 
P_polynom=*Polynom; 
Polynom=Record 
Degree: integer; 
Cof:real; 
Next:p_polynom; 
End; 
Var 
1s,L1,12,13:p polynom; 
C:char; 


Procedure Space; 
Var 
I:INTEGER; 
Begin 
For I:- 1 To 100 Do 
Writeln; 
Епа; {End Prcedure} 


Procedure Menu(Var C:Char); 
Begin 

Space; 

Мгізеіп("|-------------------------------------------------------------------- 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 
Writeln(' 


WELCOME IN FATHER AND BROTHER PROGRAM 
WELCOME IN FATHER AND BROTHER PROGRAM 


WHAT DO YOU WANT TO DO ? 


1: TO ADD(READ)POLYNOM. 
2: TO PRINT POLYNOM. 
3: TO SUM TWO POLYNOMS. 


4: TO SUB TWO POLYNOMS. 


35 


Writeln('| 5: TO MUL TWO POLYNOMS. 
Writeln('| 
Writeln('| 
Writeln('| 
| 


Writeln(' 


6: TO EXIT FROM PROGRAM. 


Мгізеіп(!|-------------------------------------------------------------------- 


Writeln(' ENTER ONE OF THE FOLOWING CHOICES '); 
Readl1n(C); 
End; 


Procedure Insert poly(var Ls:p polynom; poly:polynom); 
Var 
p,prev,t:p polynom; 
Begin 
New(t); 
t^:zpoly; 
t^.next:zNil; 
If Ls=Nil Then 
Ls:-t 
Else {*} 
Begin 
If t^.Degree»ls^.Degree Then 
Begin 
t^.next:-1s; 
l1s:st; 
End 
Else {**} 
Begin 
р:=15; 
while ((p«»Nil) And (t^.Degree«p^.Degree)) Do 
Begin 
ргем:=р; 
p:zp^.next; 
End; 
If (t^.Degree«»p^.Degree) Then 
Begin 
t^.next:zp; 
prev^.next:zt; 
End 
Else 
p^.cof:zp^.cof-*t^.cof; 
End;{End **} 
End;{End *} End; {End Procedure} 
End; {End Procedure} 
Procedure Read_Poly(Var p:p_polynom) ; 
Var R:polynom; 
Begin 


Writeln(' To Start Press Enter , But To Exit press CTRL+Z ... 


While Not Eof Do 

Begin 
Readln; 
Write('Enter The Cof ='); Readln(R.cof); 
Write('Enter The Degree='); Readln(R.degree); 


%; 
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Insert poly(P,R); 


Writeln(' To Continue Press Enter , But To Exit press CTRL4Z ... 


End; 
End; {End procedure} 


Procedure Mul_poly(1s1,1s2:p_polynom; Var 1s3:p_polynom) ; 
Var 
t1,t2:p polynom; R:polynom; 
Begin 
t1:51s1; 
While t1<>nil Do 
Begin 
%2:-152; 
While t2<>nil Do 
Begin 
R.cof:z((t1^.cof)*(t2^.cof)); 
R.Degree:=(t1*.degree+t2”*.Degree) ; 
Insert poly(1s3,R); 
t2:2t2^.next; 
End; 
t1:-t1^.next; 
End; 
End; {End procedure} 


Procedure 5ит ро1у(151,152:р ро1упот; Var 1s3:p polynom); 
Begin 
While 152<>пі1 do 
begin 
Insert poly(1s3,1s2^); 
152:-1527.пехі; 
Епа; 
While 1s1<>nil do 
Begin 
Insert poly(1s3,1s1^); 
1s1:21s1^.next; 
End; 
Епа; {Епа procedure} 


{ аза امت‎ а аль nr Ire а Бла ی‎ EE ы ыл 
Procedure Sub_poly(1s1,1s2:p_polynom; var 1s3:p polynom); 
Begin 

While 151<>пі1 do 

begin 


Insert poly(1s3,1s1^); 
151:-1517.пехі; 

Епа; 

While 1s2<>nil do 

Begin 
1s2^.cof:z((-1)*(1s2^.cof)); 
Insert poly(1s3,1s2^); 
1s2:21s2^.next; 

End; 

End; {End procedure} 


%; 
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Procedure Write_poly( p:p_polynom) ; 
Var 
t:p_polynom; 
Begin 
t:zp; 
While t«»nil do 
Begin 
Write('(',t^.cof:4:2,'x^',t^.degree, ')'); 
t:st^.next; 
End; 
Writeln; 
End; {End procedure} 


t:zp; 
While t«»nil do 
Begin 
Write('(',t^.cof:4:2,'x^',t^.degree, ')'); 
t:-t^.next; 
End; 
Writeln; 
Епа; {Епа procedure} 
Begins + жж жж ESLER EM Т ү) Program t oko жек ED ЖЖЖ ION 1 
Ls:-nil; 
Repeat 
11:=nil; 
12:=nil; 
13:=nil; 
Menu(c); 
If c='1' Then 
Begin 
Read poly(Ls); 
Writeln(' Press Enter To continue...... "ys 
Readln; 
End; 
If c='2' Then 
Begin 
Write poly(Ls); 
Writeln(' Press Enter To continue...... "s 
Readln; 
End; 
If c='3' then 
Begin 
Writeln(' Enter The polynom 1 '); 
Writeln('---------------------- و(‎ 
Read_poly(11); 
Writeln('--------------------------------------------------------- “уз 
Writeln(' Enter The polynom 2 '); 
Writeln('---------------------- “уз 
Writeln(' Enter The polynom 2 '); 
Writeln('---------------------- “уз 
Read_poly(12); 
Write poly(11); 
мгізтеіп("--------------------------------------------------------- ІН 


Write poly(12); 


Writeln('--------------------------------------------------------- 
Sum_poly(11,12,13); {sum peocedure} 
Write_poly(13); 
Writeln('--------------------------------------------------------- 
Writeln(' Press Enter To continue...... '); 
Readln; 

End; 

If c='4' then 

Begin 
Writeln(' Enter The polynom 1 '); 
Writeln('---------------------- Us 
Read poly(11); 
Writeln('--------------------------------------------------------- 
Writeln(' Enter The polynom 2 '); 
Writeln('---------------------- us 
Read poly(12); 
Write poly(11); 
Writeln('--------------------------------------------------------- 
Write poly(12); 
Writeln('--------------------------------------------------------- 
sub poly(11,12,13); {sub procedure} 
Write_poly(13); 
Writeln(' Press Enter To continue...... ")$ 
Readln; 

End; 

If c='5' then 

Begin 
Writeln(' Enter The polynom 1 '); 
Writeln('---------------------- 794 
Read_poly(11); 
Writeln('--------------------------------------------------------- 
Writeln(' Enter The polynom 2  '); 
Writeln('---------------------- a 
Read_poly(12); 
Write poly(11); 
Writeln('--------------------------------------------------------- 
Write poly(12); 
Writeln('--------------------------------------------------------- 
mul_poly(11,12,13); {muL peocedure} 
Write_poly(13); 
Writeln('--------------------------------------------------------- 
Writeln(' Press Enter To continue...... ys 
Readln; 

End; 
Writeln(' Enter The polynom 1 '); 
Writeln('---------------------- “у; 
Read_poly(11); 
Writeln('--------------------------------------------------------- 
Writeln(' Enter The polynom 2 '); 
Writeln('---------------------- "ys 
Read poly(12); 
Write poly(11); 
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Writeln('--------------------------------------------------------- '); 
Write_poly(12); 
Writeln('--------------------------------------------------------- Ys 
mul_poly(11,12,13); {muL peocedure} 
Write_poly(13); 
Writeln('--------------------------------------------------------- "ys 
Writeln(' Press Enter To continue...... "S 
Readln; 
End; 
until c-'6'; 
End. 
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المسألة 14 : مسألة الأباء والأبناء 


ليكن لدينا سلسلة الأباء ولكل أب مجموعة من الأولاد كمايلي : 


بنية المعطيات: 


TYPE 
P_CHILD=^CHILD; 
CHILD=RECORD 

CNAME : STRING [20]; 
CNEXT:P. CHILD; 
END; 
P FATHER-^FATHER; 
FATHER-RECORD 
FNAME : STRING[ 20]; 
FNEXT:P FATHER; 
CHNEXT:P. CHILD; 
END; 
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والمطلوب: 


2- إضافة أبن إلى أب موجود ضمن سلسلة الأباء . 
3- حذف أبن لأب موجود ضمن سلسلة الأباء. 

4- حذف أب بالنسبة لأبن موجود ضمن سلسلة الأبناء. 
5- طباعة أبناء أب معين موجود ضمن سلسلة الأباء. 
6- طباعة أسماء جميع الأباء الذين ليس لديهم أولاد. 
7- طباعة كل الأباء. 

8- طباعة أسم الاب الذي لدية أكبر عدد من الأولاد. 
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TYPE 
P_CHILD=*CHILD; 
CHILD=RECORD 

CNAME : STRING[ 20]; 
CNEXT:P CHILD; 
END; 
P FATHER-^FATHER; 
FATHER-RECORD 
FNAME : STRING[ 20] ; 
FNEXT:P FATHER; 
CHNEXT:P CHILD; 
END; 
VAR 
S , SON: STRING; 
L S:P FATHER; 
I:INTEGER; 
C,C1:CHAR; 
Е: BOOLEAN; 


PROCEDURE SPACE; 
VAR I: INTEGER; 
BEGIN 

FOR І:- 1 TO 100 DO 
WRITELN; 

END; {END PROCEDURE} 


PROCEDURE MENU(VAR C:CHAR); 

BEGIN 

SPACE; 

MORIR, M 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 


| 

| WELCOME IN FATHER AND BROTHER PROGRAM 
| 
| 
| 
| 
| 
| 
| 
| 
| 

WRITELN('| 2: TO ADD CHILD ACORDING TO FATHER FOUND. 

| 
| 
| 
| 
| 
| 
| 
| 
| 
| 
| 


WHAT DO YOU WANT TO DO ? 


1: TO ADD FATHER INTO SERIES IN THE CORRECT PLACE. 


WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 


3: TO DELETE SON FOR FATHER THAT FOUND IN SERIES. 


4: TO DELETE FATHER FOR SON THAT FOUND IN SERIES. 


5: TO PRINT CHILDREN FOR CERTION FATHER. 


6: TO PRINT ALL NAMES OF FATHERS THAT NO CHILDREN. 


` 9. 4. Vs وها .2 وها‎ we vw №. ж. “e 


4. 4. 4. Ve 9 Ve 9. Ve Фе Wwe we 


ыл ы ыы мыт S X X X `V ` чый Жый s... s. x. “ч 
` 


`. 
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WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 


7: TO PRINT ALL FATHERS. 


9: TO EXIT FROM PROGRAM. 


کک عع كاك اد шшш‏ عور ع عدو وت nouum uu uero necne nau dated e‏ عد و ورك WRETELNC* | «eese‏ 


WRITE(' ENTER ONE OF THE FOLOWING CHOICES '); 
READLN(C) ; 
END; 


PROCEDURE D F(VAR LS:P FATHER; FN:STRING); 
VAR Т,ТЕ:Р FATHER; 
DEL , FOUND: BOOLEAN; 


BEGIN 
DEL:=FALSE; FOUND: =FALSE; 
WHILE ((LS<>NIL) AND (NOT DEL)) DO 
BEGIN 
IF FN=LS*.FNAME THEN 
BEGIN 
DEL:=TRUE; 
T:-LS; (DELETE FATHER 4) 
LS:=LS*.FNEXT; 
DISPOSE(T); 
END 
ELSE 
BEGIN 
TE:-LS; FOUND: =FALSE; 
WHILE ((TE*.FNEXT<>NIL) AND (NOT FOUND) )DO 
BEGIN 
IF TE^.FNEXT^.FNAME-FN THEN 
FOUND : = TRUE 
ELSE 
ТЕ:=ТЕ^.ЕМЕХТ; 
END; 
IF FOUND=FALSE THEN 
WRITELN(' FATHER NOT FOUND ...... 
ELSE 
BEGIN 
Т:=ТЕ^.ЕМЕХТ; 
ТЕ :=ТЕ^. ЕМЕХТ^. ЕМЕХТ ; 
ЮІЅРОЅЕ (Т); 
DEL:=TRUE; 
END; 
END; 
END; 


END; {END PROCEDURE } 


END; 
END; {END PROCEDURE} 


8: TO PRINT FATHER NAME WHO HAS GREATEST NUMBER OF CHILDREN. 
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FUNCTION SEARCH(FN:STRING; VAR LS:P FATHER;VAR FOUND: BOOLEAN) :P FATHER; 
VAR 
T:P FATHER; 
(SERCHING FOR FATHER NAME IN THE SERIESj 

BEGIN 

T:=LS; 

FOUND: =FALSE; 

WHILE ((T<>NIL) AND (NOT FOUND)) DO 


BEGIN 
IF FN=T*.FNAME THEN 
FOUND: =TRUE 
ELSE 


Т:=Т^.ЕМЕХТ; 
END; {END WHILE} 


SEARCH: =Т; 
END; {END FUNCTION} 
(---------------------------------------------------------------------------- } 
PROCEDURE SEARCH SON(LS:P FATHER; SON:STRING;VAR P:P CHILD; VAR FOUND:BOOLEAN) ; 
VAR (THIS FUNCTION THAT GIVE IT POINTER FOR FATHER AND SEARCH FOR SON 

AND RETURN VALUE IF BE (SON NAME FOUND IN THE FATHER NAME) } 

T:P CHILD; 

BEGIN 


P:-LS^.CHNEXT; FOUND:=FALSE; 
WHILE ((P<>NIL) AND (NOT FOUND)) DO 
BEGIN 

IF P^.CNAME-SON THEN 
FOUND: = TRUE 
ELSE 
P:zP^.CNEXT; 
END; 
P:=LS*.CHNEXT; 
END; {END FUNCTION} 


(---------------------------------------------------------------------------- } 
PROCEDURE INSERT_FATHER(VAR LS:P FATHER; S:STRING); 
VAR 
TEMP,P,PREV:P FATHER; 
BEGIN (ORDER (1) ADD FATHER TO SERIES] 
NEW( TEMP) ; 


TEMP^. FNAME: =S; 
TEMP^.FNEXT:=NIL; {РРАТНЕК: POINTER FOR NEXT FATHER} 
ТЕМР^ . СНМЕХТ : =NIL; {CHNEXT:POINTER FOR HER CHILDRENS} 
IF LS=NIL THEN 
LS:=TEMP 
ELSE {*} 
BEGIN 
IF S<LS*.FNAME THEN 
BEGIN {1} 
TEMP’. FNEXT:=LS; 
LS:=TEMP; 
END 
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ELSE {**} 
BEGIN 
P:=LS; 
PREV:=P; 
WHILE ((P<>NIL) AND (TEMP^.FNAME»P^.FNAME)) DO 
BEGIN 
РКЕУ:-Р; 
P:zP^.FNEXT; 
END;(END WHILE} 
IF (TEMP^.FNAME«»P^.FNAME) THEN 
BEGIN 
TEMP^.FNEXT:zP; 
PREV^.FNEXT : ZTEMP; 
END;(END IF} 
ЕМО; {ЕЛО ELSE(**)} 
ЕМО; {ЕЛО ELSE(*)} 
END; {END PROCEDURE} 


PREV*.FNEXT:=TEMP; 
END; {END IF} 
END; {END ELSE(**) } 
END; {END ELSE(*)) 
END; {END PROCEDURE} 


PROCEDURE INSERT_CHILD(VAR LS:P_FATHER; FN,SON:STRING) ; 
VAR T:P FATHER; 
T1,P,PREV:P CHILD; 
F:BOOLEAN; 
BEGIN 
T:sLS; 
NEW(T1); {2} 
T1^.CNAME : SON; 
T1^.CNEXT : ZNIL ; 
T:=SEARCH(FN,LS,F)3 
IF F=FALSE THEN 
WRITELN(' THE FATHER NAME IS NOT FOUND ') {FATHER NOT FOUND} 
ELSE (* IF FATHER NAME FOUND (FOUND=TRUE ) } 
BEGIN 
ТЕ T*.CHNEXT=NIL THEN {IF THE SERIES IS EMPTY} 
Т^. СНМЕХТ : =Т1 {POINTER FOR FATHER IS PINT FOR CHILDREN} 
ELSE {** IF THE SERIES NOT EMPTY} 
BEGIN 
IF SON«T^.CHNEXT^.CNAME THEN 
BEGIN (IF THE SON NAME IS SMALER THAN FIRST ELEMENT] 
T1^.CNEXT: =Т^. СНМЕХТ; 
Т^, СНМЕХТ :=Т1; 
END{END WHILE} 
ELSE {*** ANY WHERE} 
BEGIN 
P:zT^.CHNEXT; 
РКЕУ:-Р; 
WHILE ((P<>NIL) AND (SON»P^.CNAME)) DO 
BEGIN 
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РКЕУ:-Р; 
P:zP^.CNEXT; 
END;(END WHILE} 
IF SON«»T^.CHNEXT^.CNAME THEN 
BEGIN 
T1^.CNEXT:zP; 
PREV^.CNEXT:zT1; 
END; {EN IF} 
END; {END ELSE ***} 
END; {END ELSE **} 
END; {END ELSE *} 
END; {END PROCEDURE} 


PROCEDURE DELETE SON(FN,SON:STRING; VAR LS:P FATHER); 
VAR T:P FATHER; 
P,PREV,TEMP,NEXT, p1:P CHILD; 
FOUND : BOOLEAN; 
BEGIN {3} 
T:=SEARCH(FN,LS, FOUND) ; 
IF FOUND=FALSE THEN 
WRITELN(' THE FATHER NAME IS NOT FOUND ..... 5 
ELSE(1) 
BEGIN 
P:=T*.CHNEXT; 
IF P=NIL THEN 


WRITELN(' THIS FATHER DOES NOT HAS CHILDREN..... ") 
ELSE {2} {IF МОТ EMPTY} 
BEGIN 
ТЕ P^.CNAME-SON THEN {Р=Т^.СНМЕХТ } 
BEGIN 
ТЕМР:-Р; 
P:zP^.CNEXT; (DELETE FIRST ELEMENT} 
DISPOSE(TEMP); 
T^.CHNEXT:zP; (Very important To Move Ls(T^.chnext to down(p))] 
P:zP^.CNEXT; (DELETE FIRST ELEMENT} 
DISPOSE(TEMP) ; 
T^.CHNEXT:zP; {Very important To Move Ls(T^.chnext to down(p))} 
END 
ELSE {3} 


BEGIN {ANY WHERE} 
NEXT:=P;  FOUND:-FALSE; 
WHILE ((P<>NIL)AND(NOT FOUND)) DO 
BEGIN 
IF P^.CNEXT^.CNAME«»SON THEN 
Р:=Р^.СМЕХТ 
ELSE 
FOUND: =TRUE; 
END; {END WHILE} 
{POINTER STOP BEFOR THE ELEMENT THAT YOU WANT TO DELETE } 
IF FOUND=FALSE THEN 
WRITELN('THE NAME OF CHILD IS NOT FOUND ....'( 
ELSE {4} 
BEGIN 
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TEMP : =P“. CNEXT; 
Р^.СМЕХТ : =Р^. СМЕХТ^. СМЕХТ; (OR P^.CNEXT:-TEMP^. CNEXT} 
DISPOSE(TEMP) ; 
END; {EN ELSE 4} 
END; {END ELSE 3} 
END; {END ELSE 2) 
END; {END ELSE 1) 


PROCEDURE DELETE_F(SON:STRING; VAR LS:P FATHER); 
VAR 
T:P FATHER; 
TEMP,P,TE:P CHILD; 
F:BOOLEAN; 
FN:STRING; 
BEGIN 
F:-FALSE; Т:=15; 
WHILE ((T<>NIL) AND (NOT F)) ро 
BEGIN 
SEARCH SON(T,SON,P,F); 
IF F=TRUE THEN 
TE:=P 
ELSE 
T:zT^.FNEXT; 
END; 
{THE LOOP THAT STOP AND(TE:P CHILD (ТЕ: IS LIST START FOR FATHER SERIES) } 
IF F=FALSE THEN 
WRITELN(' THE FATHER NAME IS NOT FOUND ') 
ELSE 
BEGIN 
“1ح : للع‎ . FNAME; 
WHILE TE<>NIL DO Т ТЕ=Р^.СНМЕХТ ; LIST START FOR FATHER SERIES} 
BEGIN 
TEMP: zTE; 
TE:zTE^.CNEXT; 
DISPOSE(TEMP); 
T^.CHNEXT: =ТЕ; 
END;(END WHILE} (T: POINTER FOR FATHERS] 
D F(LS,FN); 
END; 
(IF F=TRUE THEN Jj 
END; {END PROCEDURE} 


P1,P2:P_CHILD; 
I,E: INTEGER; 
FN: STRING; 
BEGIN 
T:zLS; Е:-0; 
WHILE T<>NIL DO 
BEGIN 
Р1:=Т^.СНМЕХТ; І:-0; 
WHILE P1<>NIL DO 
BEGIN 
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І:=1+1; 
P1:zP1^.CNEXT; 
END; 
IF I>E THEN 
BEGIN 
E:sI; 
FN:zT^.FNAME ; 
END; 
T:zT^.FNEXT; 
END; 
WRITELN(FN); 
END; (END PROCEDURE} 
PROCEDURE VIEW(LS:P FATHER); 
VAR T:P FATHER; 
BEGIN 
T:sLS; 
WHILE T<>NIL DO 
BEGIN 
ТЕ T*.CHNEXT=NIL THEN {6} 
WRITELN(T*. FNAME) ; 
T:zT^.FNEXT; 
END;(END WHILE} 
END; {END PROCEDURE} 
PROCEDURE VIEW FATHER(LS:P FATHER); 
VAR T:P FATHER; 
BEGIN 
T:sLS; 
WHILE T<>NIL DO 
BEGIN {7} 
WRITELN(T*. FNAME) ; 
Т:=Т^.ЕМЕХТ; 
END; {END WHILE} 
END; {END PROCEDURE} 


{ а аала о ааба ce ea, se به فق يجيج‎ aa Sw Se Sie SE алғы an aS نط ند بويت وجي أت‎ SR ————— aqa 
PROCEDURE V_C(FN:STRING; VAR LS:P_FATHER); 
VAR 
F:BOOLEAN ; 
TE  :P FATHER; 
C :P CHILD ; 
BEGIN {5} 


TE:=SEARCH(FN,LS,F)3 
IF F=FALSE THEN 
WRITELN(' THE FATHER NAME IS NOT FOUND ') 
ELSE 
BEGIN 
C := TE^.CHNEXT ; 
WHILE (C«»NIL) DO 
BEGIN 
WRITELN(C^.CNAME) ; 
С:=С^.СМЕХТ; 
END; {END WHILE} 
END; {END ELSE} 
END; {END PROCEDURE} 
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L S:zNIL; 

REPEAT 

L S:zNIL; 

REPEAT 

MENU(C) و‎ 

IF C='1' THEN 

BEGIN (1 ADD FATHER j { FFF FEREADY CERT 
WRITE('ENTER NAME OF FATHER: '); READLN(S); 
INSERT FATHER(L 5,5); 


WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
READLN; 

END; 

IF C='2' THEN 

BEGIN { 2 ADD SON} 


WRITE('ENTER NAME OF FATHER: '); READLN(S); {*****READY****} 
WRITE('ENTER NAME OF SON '); READLN(SON); 
INSERT CHILD(L S,S,SON); 
WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
READLN; 

END; 

IF C='3' THEN 

BEGIN 
WRITE('ENTER NAME OF FATHER:'); READLN(S); 
WRITE('ENTER NAME OF CHILD:');  READLN(SON); 
DELETE SON(S,SON,L S); 
WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
READLN; 

END; 

IF C='4' THEN 

BEGIN 

WRITE('ENTER THE NAME OF SON:'); READLN(S); 

DELETE F(S,L S); 


V C(S,L S); 

END; 

IF С='5' THEN 

BEGIN 
WRITE('ENTER THE NAME OF FATHER :'); READLN(S); 
V C(S,L S); {*****READY****} 
WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
READLN; 

END; 

ТЕ C-'6' THEN 

BEGIN 
VIEW(L S); 
WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
READLN; 

END; 

IF C='7' THEN 

BEGIN {7} 
VIEW FATHER(L S); 
WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
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READLN; 
END; 
IF C='8' THEN 
BEGIN 
GRATEST_C(L_S); 
WRITE(' PRESS ANY KEY TO MAIN MENU.... '); 
READLN; 
END; 
IF C-'9' THEN 
BEGIN 
WRITE('ARE YOU SURE TO EXIT FROM PROGRAM, TYPE Y/N ? '); READLN(C1); 
END; 
UNTIL ((C='9') AND (C1 ІМ['Ү', 'у'])); 
END. 
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